package CCN::MGW::generate;
# (c) 2007, Stephane Alnet
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
use strict; use warnings;

use CCN::MGW::probe;
use CCN::Core::FileTools;
use configuration;

sub get_template($)
{
    my $what = shift;
    return CCN::Core::FileTools::content_of("$configuration::perl_base/CCN/MGW/templates/$what");
}

sub print_config($$)
{
    my ($what,$content) = @_;
    CCN::Core::FileTools::print_to("$configuration::html_base/config/$what",$content);
}


sub run($)
{
    my $T = shift;

    mkdir "$configuration::html_base/config/etc";
    mkdir "$configuration::html_base/config/etc/wanpipe";
    mkdir "$configuration::html_base/config/etc/wanpipe/scripts";
    mkdir "$configuration::html_base/config/etc/wanpipe/interfaces";
    mkdir "$configuration::html_base/config/etc/callweaver";
    mkdir "$configuration::html_base/config/etc/ppp";
    mkdir "$configuration::html_base/config/etc/ppp/peers";

    my @ports = CCN::MGW::probe::ports();

    my $zaptel_conf = get_template("zaptel.conf.header");
    my $zapata_conf = get_template("zapata.conf.header");
    my @wanrouter_start = ();
    my @pppd_peers = ();

    my $wanpipe_id = 0;
    my $tty_dev = -1;
    my $zapata_group = 0;
    my $tdmv_id = 0;
    my $tdmv_span = 0;
    my $tdmv_base = 0;

    for my $port (@ports)
    {
        # port_id is the (system-wide) unique identifier for this port.
        my $port_id = $port->{port_id};

        # Use the presence of a media value as sanity check.
        my $fe_media = $T->{"${port_id}_fe_media"};
        warn("No information for port $port_id"), next unless defined $fe_media;

        # Check whether this port is actually in-use.
        next if $fe_media eq 'Unused';

        $zaptel_conf .= "# Port $port->{port} is $fe_media\n";

        # Line coding
        my $fe_lcode = uc $T->{"${port_id}_fe_lcode"};
        # This will work just fine for T1 but E1 is (cas|ccs)[,crc4].
        my $zaptel_coding  = lc $fe_lcode;

        # Clock source: NORMAL (line) or MASTER (internal/reference)
        my $fe_clock = uc $T->{"${port_id}_fe_clock"};
        # 0 for "Free Run" or a port number (1..8) for external reference
        my $te_ref_clock = $T->{"${port_id}_te_ref_clock"};
        if($fe_clock eq 'MASTER')
        {
            # It's actually Free Run if the reference is invalid.
            $T->{"${port_id}_te_ref_clock"} = 0,
            $te_ref_clock = 0
                if not defined $te_ref_clock or $te_ref_clock == $port->{port};
        }
        else
        {
            $T->{"${port_id}_te_ref_clock"} = 0;
            $te_ref_clock = 0;
        }

        # Line framing
        my $fe_frame = uc $T->{"${port_id}_fe_frame"};
        # The framing value will work just fine for T1 (d4 or esf) but we need more info for E1.
        my $zaptel_framing = lc $fe_frame;

        # Wanpipe name for this port.
        $wanpipe_id ++;
        my $wanpipe_name = "wanpipe${wanpipe_id}";
        push @wanrouter_start, $wanpipe_name;

        # wanpipe_type is the card model (defines the card features)
        my $wanpipe_type;
        # card_type is the wanpipe.conf CARD_TYPE (AFT, ...)
        my $card_type;

        # LBO for (respectively) wanpipe and zaptel
        my $fe_lbo;
        my $zaptel_lbo;

        # Number of ports as seen by TDMV (zaptel counts all the channels in an E1 or T1,
        # even if doesn't use all of them).
        my $tdmv_count;

        # Only handle A101, A102, A104 and A108 at this point.
        if($port->{model} =~ /^(AFT)-A(\d+)-SH$/)
        {
            $card_type = $1;
            $wanpipe_type = 'WAN_AFT_TE1';

            if($fe_media eq 'T1')
            {
                $fe_lbo     = '0DB';
                $zaptel_lbo = '0';
                $tdmv_count = 24;
            }
            if($fe_media eq 'E1')
            {
                $fe_lbo     = '120OH';
                $zaptel_lbo = '0';
                $tdmv_count = 32;
            }

            # XXX Do the echo-canceler detection magic.
        }
        # Unknown card model
        else
        {
            return "Unsupported model ".$port->{model};
        }

        # wanpipe_interfaces lists the entries under [interfaces] in wanpipe.conf
        my @wanpipe_interfaces = ();
        # wanpipe_entries contains the actual definitions for each sub-interface
        my @wanpipe_entries = ();

        # Entry for TE_SIG_MODE if it is needed
        my $te_sig_mode = '';

        # TDMV channels information
        my $tdmv_info   = '';

        # Used to store the new value of tmdv_base until we finish this port.
        my $tdmv_next_channel = $tdmv_base;

        # Locate the timeslot groups and process them
        for my $ts_name (1..2)
        {
            my $ts_group = 'tsg_'.$port->{index}.'_'.$ts_name;

            # Name of the primary sub-interface for Wanpipe
            my $wanpipe_sub = "w${wanpipe_id}g${ts_name}";
            # Name of the sub-interface that will carry IP
            my $wanpipe_ip = $wanpipe_sub;

            # Gather the signaling type (main protocol family)
            my $signaling_type = lc $T->{"${ts_group}_signaling_type"};
            warn("No information for ts_group $ts_group"), next unless defined $signaling_type;

            # Timeslots assignments for this timeslot group
            # By default assume the whole port is used for the same protocol
            my $wanpipe_channels = 'ALL';
            my $chan_start = 1;
            my $chan_end   = $tdmv_count;

            # Check whether we need to handle a fractional interface
            my $fractional = $T->{"${ts_group}_fractional"};
            $fractional = 'no' if $signaling_type =~ /^(pri|cas)$/;

            if(defined $fractional and $fractional eq 'yes')
            {
                my $fractional_chan_start = $T->{"${ts_group}_chan_start"};
                my $fractional_chan_end   = $T->{"${ts_group}_chan_end"};

                warn("Invalid fractional start channel"), next
                    unless
                        defined $fractional_chan_start
                    and $fractional_chan_start >= 1
                    and $fractional_chan_start <= $tdmv_count;
                warn("Invalid fractional end channel"), next
                    unless
                        defined $fractional_chan_end
                    and $fractional_chan_end   >= 1
                    and $fractional_chan_end   <= $tdmv_count;
                warn("Invalid fractional start-end pair"), next
                    unless $fractional_chan_start <= $fractional_chan_end;

                $chan_start = $fractional_chan_start;
                $chan_end   = $fractional_chan_end;
                # XXX Check this is the proper format.
                # XXX Also what happens if we have a fractional PRI with an embedded D-channel?
                $wanpipe_channels = "${chan_start}-${chan_end}";
            }

            # Number of channels (as seen by TDMV)
            my $tdmv_dchan;
            if($signaling_type =~ /^pri/)
            {
                if($fe_media eq 'T1')
                {
                    $tdmv_dchan = 24;
                }
                if($fe_media eq 'E1')
                {
                    $tdmv_dchan = 16;
                }
            }
            # YYY Allow to overwrite the D-channel

            # TE_SIG_MODE for E1 on AFT interfaces
            if($wanpipe_type eq 'WAN_AFT_TE1' and $fe_media eq 'E1')
            {
                # Full T1 or E1 used only for TDMV
                if( $signaling_type eq 'pri' )
                {
                    $te_sig_mode = 'TE_SIG_MODE = CCS';
                }
                if( $signaling_type eq 'cas' )
                {
                    $te_sig_mode = 'TE_SIG_MODE = CAS';
                }
            }

            # Create wanpipe.conf and zaptel.conf "span" entries for PRI and CAS prefixes (TMDV interfaces)
            if( $signaling_type =~ /^(pri|cas)/)
            {
                # Create a TDMV sub-interface
                push @wanpipe_interfaces, "$wanpipe_sub = $wanpipe_name, , TDM_VOICE, Comment";

                # Resolve zaptel's understanding of coding and framing for E1
                # XXX Double-check this
                if($fe_media eq 'E1' and $signaling_type eq 'pri')
                {
                    $zaptel_coding = $zaptel_framing eq 'crc4' ? ',crc4' : '';
                    $zaptel_framing = 'ccs';
                }
                if($fe_media eq 'E1' and $signaling_type eq 'cas')
                {
                    $zaptel_coding = $zaptel_framing eq 'crc4' ? ',crc4' : '';
                    $zaptel_framing = 'cas';
                }

                # Instantiate a new TDMV interface
                $tdmv_span ++;
                $tdmv_next_channel = $tdmv_base + $tdmv_count;

                $tdmv_info .= "TDMV_SPAN   = $tdmv_span\n";
                $tdmv_info .= "TDMV_DCHAN  = $tdmv_dchan\n" if defined $tdmv_dchan;

                # XXX Assumes hwec is available.
                push @wanpipe_entries, <<EOT;
[$wanpipe_sub]
ACTIVE_CH       = $wanpipe_channels
TDMV_ECHO_OFF   = NO
TDMV_HWEC       = YES
EOT

                my $zaptel_timing = $fe_clock eq 'NORMAL' ? $port->{port} : 0;
                $zaptel_conf .= "span=$tdmv_span,$zaptel_timing,$zaptel_lbo,$zaptel_framing,$zaptel_coding\n";
            }

            # Create timeslots for a PRI
            if( $signaling_type =~ /^pri/ )
            {
                # Generate zapata.conf entry for a PRI
                $zapata_group ++;
                $zapata_conf .= "; PRI port\ncontext=from-g${zapata_group}\ngroup=${zapata_group}\n";

                for my $i (qw(signalling_pri switchtype nsf dialplan localdialplan internationalprefix nationalprefix localprefix privateprefix unknownprefix overlapdial priindication priexclusive ))
                {
                    my $v = $T->{"${ts_group}_$i"};
                    my $n = $i;
                    $n = 'signalling' if $n eq 'signalling_pri';
                    if( defined $v and $v ne '' )
                    {
                        $zapata_conf .= "$n=$v\n" ;
                    }
                    else
                    {
                        $zapata_conf .= "; $n is not defined\n";
                    }
                }

                my $reset_interval = 'never';
                if(defined $T->{"${ts_group}_resetinterval_enabled"}
                   and $T->{"${ts_group}_resetinterval_enabled"} eq 'yes')
                {
                    my $v = $T->{"${ts_group}_resetinterval_value"};
                    $reset_interval = $v if $v >= 60;
                }
                $zapata_conf .= "resetinterval=$reset_interval\n";

                for my $timer (qw(t200 t313))
                {
                    if(defined $T->{"${ts_group}_pritimer_${timer}_override"}
                       and $T->{"${ts_group}_pritimer_${timer}_override"} eq 'yes')
                    {
                        my $v = $T->{"${ts_group}_pritimer_${timer}_value"};
                        $zapata_conf .= "pritimer => ${timer},$v\n"
                            if defined $v and $v > 0;
                    }
                }

                # Generate zaptel.conf and zapata.conf channels for a PRI.

                # D-channel
                if(defined $tdmv_dchan)
                {
                    my $zaptel_dchan = $tdmv_base + $tdmv_dchan;
                    $zaptel_conf .= "dchan=$zaptel_dchan\n";
                }

                # B-channels
                my @bchannels = ();
                for my $channel ($chan_start..$chan_end)
                {
                    push @bchannels, $tdmv_base + $channel
                        unless $channel == $tdmv_dchan;
                }
                # Find consecutive sets of channels
                while(my $first_channel = shift @bchannels)
                {
                    my $last_channel = $first_channel;
                    while(defined $bchannels[0] and $bchannels[0] == $last_channel+1)
                    {
                        $last_channel = shift @bchannels;
                    }

                    # Multiple channels
                    if( $first_channel < $last_channel )
                    {
                        $zaptel_conf .= "bchan=${first_channel}-${last_channel}\n";
                        $zapata_conf .= "channel => ${first_channel}-${last_channel}\n";
                    }
                    # Single channel
                    else
                    {
                        $zaptel_conf .= "bchan=${first_channel}\n";
                        $zapata_conf .= "channel => ${first_channel}\n";
                    }
                }
            }

            # Create timeslots for a CAS interface
            if( $signaling_type =~ /^cas/ )
            {
                # Generate zapata.conf entry for a CAS
                $zapata_group ++;
                $zapata_conf .= "; CAS port\ncontext=from-g${zapata_group}\ngroup=${zapata_group}\n";

                for my $i (qw(signalling_cas prewink preflash flash start rxwink rxflash debounce))
                {
                    my $v = $T->{"${ts_group}_$i"};
                    my $n = $i;
                    $n = 'signalling' if $n eq 'signalling_cas';
                    $zapata_conf .= "$n=$v\n" if defined $v and $v ne '';
                }

                # Generate zaptel.conf and zapata.conf channels for a CAS.
                my $first_channel = $tdmv_base + $chan_start;
                my $last_channel  = $tdmv_base + $chan_end;
                my $zaptel_signalling = $T->{"${ts_group}_signalling_cas"};
                $zaptel_signalling =~ s/_//g;
                $zaptel_signalling =~ s/^em/e&m/;

                # Multiple channels
                if( $first_channel < $last_channel )
                {
                    $zaptel_conf .= "${zaptel_signalling}=${first_channel}-${last_channel}\n";
                    $zapata_conf .= "channel => ${first_channel}-${last_channel}\n";
                }
                # Single channel
                else
                {
                    $zaptel_conf .= "${zaptel_signalling}=${first_channel}\n";
                    $zapata_conf .= "channel => ${first_channel}\n";
                }
            }

            # Gather MTU and MRU for data protocols
            my $mtu =  $T->{"${ts_group}_mtu"};
            $mtu = 1500 if not defined $mtu or $mtu !~ /^\d+$/;
            my $mru =  $T->{"${ts_group}_mru"};
            $mru = 1500 if not defined $mru or $mru !~ /^\d+$/;

            # Create a sub-interface for HDLC
            if( $signaling_type eq 'hdlc' )
            {
                push @wanpipe_interfaces, "$wanpipe_sub = $wanpipe_name, , WANPIPE, Comment";
                push @wanpipe_entries, <<EOT;
[$wanpipe_sub]
HDLC_STREAMING      = YES
ACTIVE_CH           = $wanpipe_channels
MTU                 = $mtu
MRU                 = $mru
DATA_MUX            = NO
MULTICAST           = NO
DYN_INTR_CFG        = NO
TRUE_ENCODING_TYPE  = NO
GATEWAY             = YES
EOT
            }

            # Create the sub-interfaces for Cisco HDLC
            if( $signaling_type eq 'chdlc' )
            {
                $wanpipe_ip = "${wanpipe_sub}chdl";
                push @wanpipe_interfaces, "$wanpipe_sub = $wanpipe_name, , STACK, Comment";
                push @wanpipe_interfaces, "$wanpipe_ip = $wanpipe_name, , WANPIPE, chdlc, ${wanpipe_sub}.chdlc";
                push @wanpipe_entries, <<EOT;
[$wanpipe_ip]
MULTICAST           = NO
DYN_INTR_CFG        = YES
TRUE_ENCODING_TYPE  = NO
GATEWAY             = YES

[${wanpipe_sub}.chdlc]
KEEPALIVE_TIMER         = 5
KEEPALIVE_ERROR_MARGIN  = 3

[$wanpipe_sub]
HDLC_STREAMING      = YES
ACTIVE_CH           = $wanpipe_channels
MTU                 = $mtu
MRU                 = $mru
DATA_MUX            = NO
EOT
            }

            # Create the sub-interfaces for PPP
            # Note: at this time my understanding for MLPPP is that we
            #       should create PPP interfaces with the same IP pairs.
            if( $signaling_type eq 'ppp' )
            {
                $tty_dev ++;
                $wanpipe_ip = "${wanpipe_sub}tty";
                push @wanpipe_interfaces, "$wanpipe_sub = $wanpipe_name, , STACK, Comment";
                push @wanpipe_interfaces, "$wanpipe_ip = $wanpipe_name, $tty_dev, TTY, tty, ${wanpipe_sub}.tty";
                push @wanpipe_entries, <<EOT;
[$wanpipe_ip]

[${wanpipe_sub}.tty]

[$wanpipe_sub]
HDLC_STREAMING      = YES
ACTIVE_CH           = $wanpipe_channels
MTU                 = $mtu
MRU                 = $mru
DATA_MUX            = NO
EOT

                push @pppd_peers, "isp_${wanpipe_ip}";
            }

            # Create wanrouter IP configuration profiles
            my $local_ip = $T->{"${ts_group}_local_ip"};
            my $remote_ip = $T->{"${ts_group}_remote_ip"};
            my $netmask = $T->{"${ts_group}_netmask"};

            if( defined $local_ip  and $local_ip  ne '' and
                defined $remote_ip and $remote_ip ne '' and
                defined $netmask   and $netmask   ne '' )
            {
                 print_config("etc/wanpipe/interfaces/${wanpipe_ip}",<<SHELL);
# Wanrouter interface configuration file
# name: $wanpipe_ip
#
DEVICE=$wanpipe_ip
IPADDR=$local_ip
NETMASK=$netmask
POINTOPOINT=$remote_ip
ONBOOT=yes
GATEWAY=$remote_ip
SHELL

                print_config("etc/ppp/peers/isp_${wanpipe_ip}",<<EOT);
ttyWP${tty_dev}          #Bind to WANPIPE device ${wanpipe_sub}
${local_ip}:${remote_ip}
#user bonded-isp-username
EOT
            }

        } # for $ts_group

        # Generate the wanpipe interface configuration file.
        # Note: the parser for wanpipe.conf seems to be easily confused, so we
        #       insert extra blank lines for good measure.
        my $wanpipe_interfaces = join("\n\n",@wanpipe_interfaces);
        my $wanpipe_entries    = join("\n\n",@wanpipe_entries);

        my $wanpipe_conf = <<EOT;
# =====
# $wanpipe_name Configuration File
# =====

[devices]
$wanpipe_name = $wanpipe_type, Comment

[interfaces]
$wanpipe_interfaces

[$wanpipe_name]
CARD_TYPE           = $card_type
S514CPU             = $port->{cpu}
CommPort            = PRI
AUTO_PCISLOT        = NO
PCISLOT             = $port->{slot}
PCIBUS              = $port->{bus}
FE_MEDIA            = $fe_media
FE_LCODE            = $fe_lcode
FE_FRAME            = $fe_frame
FE_LINE             = $port->{port}
TE_CLOCK            = $fe_clock
TE_REF_CLOCK        = $te_ref_clock
$te_sig_mode
TE_HIGHIMPEDANCE    = NO
LBO                 = $fe_lbo
FE_TXTRISTATE       = NO
MTU                 = 1500
UDPPORT             = 9000
TTL                 = 255
IGNORE_FRONT_END    = NO
$tdmv_info

$wanpipe_entries
EOT

        print_config("etc/wanpipe/${wanpipe_name}.conf",$wanpipe_conf);

        # Move to the next interface
        $tdmv_base = $tdmv_next_channel;
    } # for $port

    # Generate wanrouter.rc
    my $wanrouter_rc = get_template("wanrouter.rc");
    my $wanrouter_start = join(' ',@wanrouter_start);
    $wanrouter_rc =~ s/\$\{WANPIPE_DEVICES\}/$wanrouter_start/g;
    print_config("etc/wanpipe/wanrouter.rc",$wanrouter_rc);

    # Generate wanpipe/scripts/start (for zaptel and ppp)
    my $scripts_start = get_template("start");
    my $pppd_calls = join("\n", map { "pppd call $_" } @pppd_peers );
    $scripts_start =~ s/\$\{PPPD_CALLS\}/$pppd_calls/g;
    print_config("etc/wanpipe/scripts/start",$scripts_start);

    # Generate zaptel.conf and zapata.conf
    print_config("etc/zaptel.conf",$zaptel_conf);
    print_config("etc/callweaver/zapata.conf",$zapata_conf);

    # Generate ppp/options
    my $ppp_options = get_template("ppp_options");
    print_config("etc/ppp/options",$ppp_options);

    # Everything went fine
    return '';
}

1;